home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / promise.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-17  |  1.7 KB  |  62 lines
  1. /*
  2.  *
  3.  *  p r o m i s e . c        -- Promises management
  4.  *
  5.  *
  6.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  7.  * 
  8.  *
  9.  * Permission to use, copy, and/or distribute this software and its
  10.  * documentation for any purpose and without fee is hereby granted, provided
  11.  * that both the above copyright notice and this permission notice appear in
  12.  * all copies and derived works.  Fees for distribution or use of this
  13.  * software or derived works may only be charged with express written
  14.  * permission of the copyright holder.  
  15.  * This software is provided ``as is'' without express or implied warranty.
  16.  *
  17.  * This software is a derivative work of other copyrighted softwares; the
  18.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  19.  *
  20.  *
  21.  *            Author: Erick Gallesio [eg@kaolin.unice.fr]
  22.  *    Creation date:  2-Jun-1993 12:27
  23.  * Last file update: 10-Dec-1995 22:31
  24.  *
  25.  */
  26.  
  27. #include "stk.h"
  28.  
  29. /*
  30.  * Delay is implemented by syntax_delay in syntax.c
  31.  */
  32.  
  33. PRIMITIVE STk_force(SCM promise)
  34. {
  35.   SCM z;
  36.  
  37.   if (NPROMISEP(promise)) return promise;
  38.  
  39.   if (promise->storage_as.promise.resultknown) 
  40.     /* promise was alraedy evaluated. Simply return expr field */
  41.     return promise->storage_as.promise.expr;
  42.  
  43.   z = Apply(promise->storage_as.promise.expr, NIL);
  44.  
  45.   if (promise->storage_as.promise.resultknown)
  46.     /* R4RS: "A promise may refer to its own value.... Forcing such
  47.      * a promise may cause the promise to be forced a second time before
  48.      * the first value has been computed.
  49.      */
  50.     return promise->storage_as.promise.expr;
  51.   else {
  52.     promise->storage_as.promise.expr          = z;
  53.     promise->storage_as.promise.resultknown  = 1;
  54.     return z;
  55.   }
  56. }
  57.  
  58. PRIMITIVE STk_promisep(SCM promise)
  59. {
  60.   return PROMISEP(promise)? Truth: Ntruth;
  61. }
  62.